ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UAssociation.inc1.p

Text File | 1990-10-25 | 7.9 KB | 351 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{UAssociation.inc1.p}
{Copyright © 1988-1990 by Apple Computer Inc.  All rights reserved.}

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TEntry.IEntry(itsKey, itsValue: Str255);

    VAR
        fi:                 FailInfo;

    PROCEDURE HdlIEntry(error: OSErr;
                        message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    IObject;

    fKey := NIL;
    fValue := NIL;
    CatchFailures(fi, HdlIEntry);

    fKey := NewString(itsKey);
    FailNIL(fKey);

    fValue := NewString(itsValue);
    FailNIL(fValue);

    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TEntry.Free; OVERRIDE;

    BEGIN
    Handle(fKey) := DisposeIfHandle(fKey);
    Handle(fValue) := DisposeIfHandle(fValue);

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TEntry.SetValue(VAR value: Str255);

    BEGIN
    SetString(fValue, value);
    IF fValue^^ <> value THEN
        BEGIN
        FailOSErr(memFullErr);                            { SetString may attempt to increase the
                                                         handle size, yet it does not return
                                                         errors! }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TEntry.Fields(PROCEDURE DoToField(fieldName: Str255;
                                            fieldAddr: Ptr;
                                            fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TEntry', NIL, bClass);
    DoToField('fKey', @fKey, bStringHandle);
    DoToField('fValue', @fValue, bStringHandle);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TEntriesList.Compare(item1, item2: TObject): INTEGER;

    BEGIN
    IF TEntry(item1).fKey^^ < TEntry(item2).fKey^^ THEN
        Compare := kItem1LessThanItem2
    ELSE IF TEntry(item1).fKey^^ > TEntry(item2).fKey^^ THEN
        Compare := kItem1GreaterThanItem2
    ELSE
        Compare := kItem1EqualItem2;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TEntriesList.IEntriesList;

    BEGIN
    ISortedList;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TEntriesList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                  fieldAddr: Ptr;
                                                  fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TEntriesList', NIL, bClass);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.IAssociation;

    VAR
        anEntriesList:        TEntriesList;
        fi:                 FailInfo;

    PROCEDURE HdlIAssociation(error: OSErr;
                              message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    IObject;

    fEntries := NIL;                                    { So Free will work on failure }
    CatchFailures(fi, HdlIAssociation);

    New(anEntriesList);
    FailNIL(anEntriesList);
    anEntriesList.IEntriesList;
    fEntries := anEntriesList;
    {$IFC qDebug}
    fEntries.SetEltType('TEntry');
    {$ENDC}

    Success(fi);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.Free; OVERRIDE;

    BEGIN
    fEntries := TEntriesList(FreeListIfObject(fEntries));

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.EachEntryDo(PROCEDURE DoToEntry(theEntry: TEntry));

    BEGIN
    fEntries.Each(DoToEntry);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TAssociation.EntryWithKey(keyStr: Str255): TEntry;

    FUNCTION TestKey(theEntry: TObject): INTEGER;

        BEGIN
        IF keyStr < TEntry(theEntry).fKey^^ THEN
            TestKey := kItemGreaterThanCriteria
        ELSE IF keyStr > TEntry(theEntry).fKey^^ THEN
            TestKey := kItemLessThanCriteria
        ELSE
            TestKey := kItemEqualCriteria;
        END;

    BEGIN
    EntryWithKey := TEntry(fEntries.Search(TestKey));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TAssociation.EntryWithValue(valueStr: Str255): TEntry;

    FUNCTION MatchesValue(theEntry: TEntry): BOOLEAN;

        BEGIN
        MatchesValue := valueStr = theEntry.fValue^^;
        END;

    BEGIN
    EntryWithValue := FirstEntryThat(MatchesValue);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TAssociation.FirstEntryThat(FUNCTION TestEntry(theEntry: TEntry): BOOLEAN): TEntry;

    BEGIN
    FirstEntryThat := TEntry(fEntries.FirstThat(TestEntry));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.InsertEntry(keyStr, valueStr: Str255);

    VAR
        anEntry:            TEntry;

    BEGIN
    anEntry := EntryWithKey(keyStr);
    IF anEntry <> NIL THEN
        anEntry.SetValue(valueStr)
    ELSE
        BEGIN
        New(anEntry);
        FailNIL(anEntry);
        anEntry.IEntry(keyStr, valueStr);
        fEntries.Insert(anEntry);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TAssociation.KeyAt(valueStr: Str255;
                            VAR keyStr: Str255): BOOLEAN;

    VAR
        theEntry:            TEntry;

    FUNCTION MatchesValue(theEntry: TEntry): BOOLEAN;

        BEGIN
        MatchesValue := valueStr = theEntry.fValue^^;
        END;

    BEGIN
    theEntry := FirstEntryThat(MatchesValue);
    IF theEntry = NIL THEN
        BEGIN
        keyStr := '';
        KeyAt := FALSE;
        END
    ELSE
        BEGIN
        keyStr := theEntry.fKey^^;
        KeyAt := TRUE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.RemoveValueAt(keyStr: Str255);

    VAR
        theEntry:            TEntry;

    FUNCTION TestKey(anItem: TObject): INTEGER;

        BEGIN
        IF keyStr < TEntry(anItem).fKey^^ THEN
            TestKey := kItemGreaterThanCriteria
        ELSE IF keyStr > TEntry(anItem).fKey^^ THEN
            TestKey := kItemLessThanCriteria
        ELSE
            TestKey := kItemEqualCriteria;
        END;

    BEGIN
    theEntry := TEntry(fEntries.Search(TestKey));
    IF theEntry <> NIL THEN
        fEntries.Delete(theEntry);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

PROCEDURE TAssociation.RemoveKeyAt(valueStr: Str255);

    VAR
        theEntry:            TEntry;

    FUNCTION MatchesValue(theEntry: TEntry): BOOLEAN;

        BEGIN
        MatchesValue := valueStr = theEntry.fValue^^;
        END;

    BEGIN
    theEntry := FirstEntryThat(MatchesValue);
    IF theEntry <> NIL THEN
        fEntries.Delete(theEntry);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAAssociationRes}

FUNCTION TAssociation.ValueAt(keyStr: Str255;
                              VAR valueStr: Str255): BOOLEAN;

    VAR
        theEntry:            TEntry;

    FUNCTION CompareKey(theEntry: TObject): INTEGER;

        BEGIN
        IF keyStr < TEntry(theEntry).fKey^^ THEN
            CompareKey := kItemGreaterThanCriteria
        ELSE IF keyStr > TEntry(theEntry).fKey^^ THEN
            CompareKey := kItemLessThanCriteria
        ELSE
            CompareKey := kItemEqualCriteria;
        END;

    BEGIN
    theEntry := TEntry(fEntries.Search(CompareKey));
    IF theEntry = NIL THEN
        BEGIN
        valueStr := '';
        ValueAt := FALSE;
        END
    ELSE
        BEGIN
        valueStr := theEntry.fValue^^;
        ValueAt := TRUE;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TAssociation.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                  fieldAddr: Ptr;
                                                  fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TAssociation', NIL, bClass);
    DoToField('fEntries', @fEntries, bObject);
    INHERITED Fields(DoToField);
    END;